SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00002 1 05-25-9408:09ALL LARRY HADLEY Directory Object SWAG9405 97 ª╢ {π Next in this continuing series of code: the actual directryπ object.π}ππUnit Dirs;π{π A directory management object from a concept originally by Allanπ Holub, as discussed in Byte Dec/93 (Vol 18, No 13, page 213)ππ Turbo Pascal code by Larry Hadley, tested using BP7.π}πINTERFACEππUses Sort, DOS;ππTYPEπ pSortSR = ^oSortSR;π oSortSR = OBJECT(oSortTree)π procedure DeleteNode(var Node); virtual;π end;ππ callbackproc = procedure(name :string; lev :integer);ππ prec = ^searchrec;ππ pentry = ^entry;π entry = recordπ fil :prec;π next, last :pentry;π end;ππ pdir = ^dir;π dir = recordπ flist :pentry;π count :word;π path :string[80];π end;ππ pDirectry = ^Directry;π Directry = OBJECTπ dirroot :pdir;ππ constructor Init(path, filespec :string; attribute :byte);π destructor Done;ππ procedure Load(path, filespec :string; attribute :byte);π procedure Sort;π procedure Print;π END;ππCONSTπ NotDir = ReadOnly+Hidden+SysFile+VolumeID+Archive;π dosattr : array[0..8] of char = '.rhsvdaxx';ππprocedure TraverseTree(root :string; pcallproc :pointer; do_depth :boolean);ππIMPLEMENTATIONππvarπ treeroot :pSortSR; { sorting tree object }ππprocedure disposelist(ls :pentry);πvarπ lso :pentry;πbeginπ while ls<>NIL doπ beginπ dispose(ls^.fil);π lso := ls;π ls := ls^.next;π dispose(lso);π end;πend;ππ{ Define oSortSR.DeleteNode method so object knows how to dispose ofπ individual data pointers in the event that "Done" is called beforeπ tree is empty. }πprocedure oSortSR.DeleteNode(var Node);πvarπ pNode :pRec ABSOLUTE Node;πbeginπ dispose(pNode);πend;ππconstructor Directry.Init(path, filespec :string; attribute :byte);πvarπ pathspec :string;π node :pentry;π i :word;πBEGINπ FillChar(Self, SizeOf(Self), #0);π Load(path, filespec, attribute); { scan specified directory }π if dirroot^.count=0 then { if no files were found, abort }π beginπ if dirroot<>NIL thenπ beginπ disposelist(dirroot^.flist);π dispose(dirroot);π end;π FAIL;π end;π { the following code expands the pathspec to a full qualified path }π pathspec := dirroot^.path+'\';π node := dirroot^.flist;π while ((node^.fil^.name='.') or (node^.fil^.name='..')) andπ (node^.next<>NIL) doπ node := node^.next;π if node^.fil^.name='..' thenπ pathspec := pathspec+'.'π elseπ pathspec := pathspec+node^.fil^.name;π pathspec := FExpand(pathspec);π i := Length(pathspec);π repeatπ Dec(i);π until (i=0) or (pathspec[i]='\');π if i>0 thenπ beginπ Delete(pathspec, i, Length(pathspec));π dirroot^.path := pathspec;π end;πEND;ππdestructor Directry.Done;πbeginπ if dirroot<>NIL thenπ beginπ disposelist(dirroot^.flist);π dispose(dirroot);π end;πend;ππprocedure Directry.Load(path, filespec :string; attribute :byte);π{ scan a specified directory with a specified wildcard and attributeπ byte }πvarπ count : word;π pstr : pathstr;π dstr : dirstr;π srec : SearchRec;π dirx : pdir;π firstfl, thisfl, lastfl : pentry;πbeginπ count := 0;π New(firstfl);π with firstfl^ doπ beginπ next := NIL; last := NIL; New(fil);π end;π thisfl := firstfl; lastfl := firstfl;π dstr := path;π if path = '' then dstr := '.';π if dstr[Length(dstr)]<>'\' then dstr := dstr+'\';π if filespec = '' then filespec := '*.*';π pstr := dstr+filespec;ππ FindFirst(pstr, attribute, srec);π while DosError=0 do { while new files are found... }π beginπ if srec.attr = (srec.attr and attribute) thenπ { make sure the attribute byte matches our required atttribute mask }π beginπ if count>0 thenπ { if this is NOT first file found, link in new node }π beginπ New(thisfl);π lastfl^.next := thisfl;π thisfl^.last := lastfl;π thisfl^.next := NIL;π New(thisfl^.fil);π lastfl := thisfl;π end;π thisfl^.fil^ := srec;π Inc(count);π end;π FindNext(srec);π end;π { construct root node }π New(dirx);π with dirx^ doπ flist := firstfl;π dirx^.path := path; { path specifier for directory list }π dirx^.count := count; { number of files in the list }ππ if dirroot=NIL thenπ dirroot := dirxπ elseπ beginπ disposelist(dirroot^.flist);π dispose(dirroot);π dirroot := dirx;π end;πend;ππ{ The following function is the far-local function needed for theπ SORT method (which uses the sort unit posted earlier)π Note that this is hard-coded to sort by filename, then extension.π I plan to rewrite this later to allow user-selectable sortπ parameters and ordering. }πfunction Comp(d1, d2 :pointer):integer; far;π varπ data1 :pRec ABSOLUTE d1;π data2 :pRec ABSOLUTE d2;π name1, name2, ext1, ext2 :string;π beginπ { This assures that the '.' and '..' dirs will always be the firstπ listed. }π if (data1^.name='.') or (data1^.name='..') thenπ beginπ Comp := -1;π EXIT;π end;π if (data2^.name='.') or (data2^.name='..') thenπ beginπ Comp := 1;π EXIT;π end;π with data1^ doπ beginπ name1 := Copy(name, 1, Pos('.', name)-1);π ext1 := Copy(name, Pos('.', name)+1, 3);π end;π with data2^ doπ beginπ name2 := Copy(name, 1, Pos('.', name)-1);π ext2 := Copy(name, Pos('.', name)+1, 3);π end;π if name1=name2 thenπ { If filename portion is equal, use extension to resolve tie }π beginπ if ext1=ext2 thenπ { There should be NO equal filenames, but handle anyways forπ completeness... }π Comp := 0π elseπ if ext1>ext2 thenπ Comp := 1π elseπ Comp := -1;π endπ elseπ if name1>name2 thenπ Comp := 1π elseπ Comp := -1;π end;ππ{ Sort method uses the sort unit to sort the collected directoryπ entries. }πprocedure Directry.Sort;πvarπ s1, s2 :string;π p1 :pentry;ππ { This local procedure keeps code more readable }π procedure UpdatePtr(var prev :pentry; NewEntry :pointer);π beginπ if NewEntry<>NIL then { check to see if tree is empty }π beginπ New(prev^.next);π prev^.next^.fil := NewEntry;π prev^.next^.last := prev;π prev := prev^.next;π prev^.next := NIL;π endπ elseπ prev := prev^.next;π { tree is empty, flag "done" with NIL pointer }π end;ππbeginπ p1 := dirroot^.flist;π New(treeroot, Init(Comp));π{ Create a sort tree, point to our COMP function }π while p1<>NIL doπ{ Go through our linked list and insert the items into the sortingπ tree, dispose of original nodes as we go. }π beginπ if p1^.last<>NIL thenπ dispose(p1^.last);π treeroot^.InsertNode(p1^.fil);π if p1^.next=NIL thenπ beginπ dispose(p1);π p1 := NIL;π endπ elseπ p1 := p1^.next;π end;π{ Reconstruct directory list from sorted tree }π New(dirroot^.flist);π with dirroot^ doπ beginπ flist^.next := NIL;π flist^.last := NIL;π flist^.fil := treeroot^.ReadLeftNode;π end;π if dirroot^.flist^.fil<>NIL thenπ beginπ p1 := dirroot^.flist;π while p1<>NIL doπ UpdatePtr(p1, treeroot^.ReadLeftNode);π end;π{ We're done with sorting tree... }π dispose(treeroot, Done);πend;ππprocedure Directry.Print;π{ currently prints the entire list, may modify this later to allowπ selective printing }πvarπ s, s1 :string;π e :pentry;π dt :DateTime;π dbg :byte;ππ procedure DoDateEle(var sb :string; de :word);π beginπ Str(de, sb);π if Length(sb)=1 then { Add leading 0's}π sb := '0'+sb;π end;ππbeginπ if dirroot=NIL then EXIT; { make sure empty dirs aren't attempted }π e := dirroot^.flist;π while e<>NIL doπ beginπ s := '';π with e^.fil^ doπ beginπ dbg := 1;π repeatπ case dbg of { parse attribute bits }π 1: s := s+dosattr[(attr and $01)];π 2: s := s+dosattr[(attr and $02)];π 3: if (attr and $04) = $04 thenπ s := s+dosattr[3]π elseπ s := s+dosattr[0];π 4: if (attr and $08) = $08 thenπ s := s+dosattr[4]π elseπ s := s+dosattr[0];π 5: if (attr and $10) = $10 thenπ s := s+dosattr[5]π elseπ s := s+dosattr[0];π 6: if (attr and $20) = $20 thenπ s := s+dosattr[6]π elseπ s := s+dosattr[0];π elseπ s := s+dosattr[0];π end;π Inc(dbg);π until dbg>8;π s := s+' ';π { Kludge to make sure that extremely large files (>=100MB) don'tπ overflow size field... }π if size<100000000 thenπ Str(size:8, s1)π elseπ beginπ Str((size div 1000):7, s1); { decimal kilobytes }π s1 := s1+'k';π end;π s := s+s1+' ';π { Format date/time fields }π UnpackTime(Time, dt);π {month}π DoDateEle(s1, dt.month); s := s+s1+'/';π {day}π DoDateEle(s1, dt.day); s := s+s1+'/';π {year}π DoDateEle(s1, dt.year); s := s+s1+' ';π {hour}π DoDateEle(s1, dt.hour); s := s+s1+':';π {minutes}π DoDateEle(s1, dt.min); s := s+s1+':';π {seconds}π DoDateEle(s1, dt.sec); s := s+s1+' - ';π s := s+dirroot^.path+'\'+name;π end;π Writeln(s); s := '';π e := e^.next;π end;π Writeln; Writeln(' ', dirroot^.count, ' files found.'); Writeln;πend;ππ{ If TraverseTree is not given a callback procedure, this one isπ used. }πprocedure DefaultCallback(name :string; lev :integer); far;πvarπ s :string;πconstπ spaces = ' ';πbeginπ s := Copy(spaces, 1, lev*4); s := s+name;π Writeln(s);πend;ππ{ TraverseTree is untested as yet, rest of code (above) works fine.π Note that TraverseTree is NOT a member method of DIRECTRY. Readπ the BYTE Dec/93 article for a clarification of why it is goodπ that it not be a member.}πprocedure TraverseTree(root :string; pcallproc :pointer; do_depth :boolean);πvarπ level :integer;π fullpath :string;π rootdir :pdir;πconstπ callproc : callbackproc = DefaultCallBack;ππ { Actual recursive procedure to scan down directory structureπ using the DIRECTRY object. }π procedure Tree(newroot :string; callee :callbackproc; do_last :boolean);π varπ subdirs :pdirectry;π direntry :pentry;ππ Procedure DoDir;π beginπ New(subdirs, Init(newroot, '*.*', NotDir));π if subdirs<>NIL thenπ beginπ subdirs^.sort;π direntry := subdirs^.dirroot^.flist;π while direntry<>NIL doπ beginπ fullpath := newroot+'\'+direntry^.fil^.name;π callee(newroot, level);π direntry := direntry^.next;π end;π dispose(subdirs, done);π end;π end;ππ beginπ if not(do_last) thenπ DoDir;ππ New(subdirs, Init(newroot, '*.*', directory));ππ if subdirs<>NIL thenπ beginπ subdirs^.sort;π direntry := subdirs^.dirroot^.flist;π while direntry<>NIL doπ beginπ Inc(level);π fullpath := newroot+'\'+direntry^.fil^.name;π Tree(fullpath, callee, do_last);π dec(level);π direntry := direntry^.next;π end;π dispose(subdirs, done);π end;ππ if do_last thenπ DoDir;π end;ππbeginπ level := 0;ππ if pcallproc<>NIL thenπ callproc := callbackproc(pcallproc^);ππ root := fexpand(root);π if root[Length(root)]='\' thenπ Delete(root, Length(root), 1);ππ if not(do_depth) thenπ callproc(root, level);ππ Tree(root, callproc, do_depth);ππ if do_depth thenπ callproc(root, level);πend;ππEND.π 2 05-26-9406:20ALL TIMO SALMI Hiding a Directory SWAG9405 8 ª╢ {π> browsing. Q59 (How do you hide a directory?) leapt out at me as it'sπsomethingππQ53 actually.ππ> I have been trying to do for ages. However on closer examination theπ'solution'π> proved to be calling the SETFATTR function (either directly or through it'sπ> DOS interrupt.) This worried me- I am SURE I tried this, and withoutπsuccess.π> It worked fine for ordinary files, but NOT directories. In fact I have aππThat's very strange since I have no problems when I testπ}ππuses Dos;ππprocedure HIDE (dirname : string);πvar regs : registers;πbeginπ FillChar (regs, SizeOf(regs), 0);π dirname := dirname + #0;π regs.ah := $43;π regs.al := $01;π regs.ds := Seg(dirname[1]);π regs.dx := Ofs(dirname[1]);π regs.cx := 2; { set bit 1 on }π Intr ($21, regs);π if regs.Flags and FCarry <> 0 thenπ writeln ('Failed to hide');πend; (* hide *)ππbeginπ HIDE ('r:\tmpdir');πend.π
